perm filename TMP[X,ALS] blob
sn#805247 filedate 1985-10-09 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00004 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 if wide > 36 then
C00007 00003 ! PIXEL to GF CONVERSION: the M (Make GF) command
C00015 00004
C00020 ENDMK
C⊗;
if wide > 36 then
begin "bigc"
weat ← startingat + 1;
w_count ← (wide div 36) +1;
while true do
begin "w1"
for i ← 1 til w_count do
if M[weat + i] ≠ 0 then done "w1";
weat ← weat + w_count;
decr(data_rows);
incr(rows_top);
decr(del_n);
decr(max_n);
end "w1";
for therow ← 1 til data_rows do
begin "dorows"
itis ← M[weat ← weat + 1];
! tpri(<cvs(therow)&","&cvos(itis)>);
blankrows ← 0;
while true do
begin "w2"
for i ← 1 til w_count do
if M[weat + i] ≠ 0 then done "w2";
weat ← weat + w_count;
incr(blankrows);
incr(therow);
end "w2";
if blankrows > 0 then
begin
stow(skip1);
stow(blankrows);
tpri(<pname(character)&" skip1 "&cvs(blankrows)>);
end;
first_change ← true;
p_count ← 0;
itwas ← itis;
for column ← 1 til wide do
begin
if itwas > 0 then
begin
if itis > 0 then incr(p_count) else change_c;
end
else
begin
if itis < 0 then incr(p_count) else change_c;
end;
itis ← itis lsh 1;
if column mod 36 = 0 ∧ column≠wide then
itis ← M[weat ← weat + 1];
end;
end "dorows";
end "bigc"
else
begin "litc"
therebe ← point(wide,M[startingat+1],35);
itis ← ildb(therebe) lsh (36 - wide);
while itis = 0 do
begin
decr(data_rows);
incr(rows_top);
decr(del_n);
decr(max_n);
itis ← ildb(therebe) lsh (36 - wide);
end;
for therow ← 1 til data_rows do
begin "litdorows"
if therow >1 then itis ← ildb(therebe) lsh (36 - wide);
! tpri(<cvs(therow)&","&cvos(itis)>);
blankrows ← 0;
while itis = 0 do
begin
! tpri(<cvs(therow)&","&" "&cvos(itis)>);
incr(blankrows);
incr(therow);
itis ← ildb(therebe) lsh (36 - wide);
end;
if blankrows > 0 then
begin
stow(skip1);
stow(blankrows);
tpri(<pname(character)&" skip1 "&cvs(blankrows)>);
end;
first_change ← true;
p_count ← 0;
itwas ← itis;
for column ← 1 til wide do
begin
if itwas ≥ 0 then
begin
if itis ≥ 0 then incr(p_count) else change_c;
end
else
begin
if itis < 0 then incr(p_count) else change_c;
end;
itwas ← itis;
itis ← itis lsh 1;
end;
end "litdorows";
if p_count >0 then
tpri(<" p_count "&cvs(p_count)&" at "&cvs(character)&" with therow "&cvs(therow)>);
end "litc";
restow(del_n,saved_loc +2);
restow(max_n,saved_loc +3);
if character = 97 then
tpri(<" del_m "&cvs(del_m)&" max_m "& cvs(max_m)&
" del_n "&cvs(del_n)&" max_n "&cvs(max_n)>);
! PIXEL to GF CONVERSION: the M (Make GF) command;
procedure fnt_2_GF(INTEGER ARRAY M;
integer onchannel,startingat,charwidth,character,height,baselinehi);
begin "f2gf"
! Takes the glyph at location startingat, and translates it
into GF representation, putting the result on channel onchannel.
The glyph is character, the font width is charwidth;
integer wide,left_kern,rows_top,data_rows;
integer max_m,del_m,max_n,del_n,dm; ! Eight bit GF bytes;
integer w,p; ! For GF byte char width and data pointer;
! Wide is the actual width of this particular character, left_kern its
left kerning. Rows_top is the number of rows from the top of the glyph
(which are blanks). Data_rows is the number of rows in this glyph;
integer i,j,therebe,weat,therow,itis,itwas,column;
integer blankrows,p_count;
boolean blankflag,first_change;
define change_c = ⊂
begin
if therow > 1 and first_change = true and blankrows = 0 then
begin
if itis < 0 then
begin
stow(new_row + p_count);
! tpri(<cvs(therow)&","&cvs(column)&
" new_row "&cvs(p_count)&
" "&cvos(itis)>);
end
else begin
stow(new_row);
if p_count ≥ 64 then stow(paint1);
stow(p_count);
! tpri(<cvs(therow)&","&cvs(column)&
" new_row 0 paint"&cvs(p_count)&
" "&cvos(itis)>);
end;
end
else begin
if first_change = true and itis > 0 then stow(0);
if p_count ≥ 64 then stow(paint1);
stow(p_count);
! tpri(<cvs(therow)&","&cvs(column)&
" paint"&cvs(p_count)&
" "&cvos(itis)>);
blankrows ← 0;
end;
itwas ← itis;
p_count ← 1;
first_change ← false;
end ⊃;
define paint1 = 64; ! move right a given number of columns then switch colors;
define boc = 67; ! beginning of a character;
define boc1 = 68; ! abbreviated boc, followed by 5 bytes;
define eoc = 69; ! end of a character;
define skip0 = 70; ! skip no blank rows;
define skip1 = 71; ! skip over blank rows as specfied in next byte;
define new_row = 74; ! move down one row and then right;
define char_loc0 = 246; ! character locators in the postamble;
wide ← M[startingat] lsh -27;
if wide = 0 then wide ← charwidth;
left_kern ← M[startingat+1] ash -27;
rows_top ← (M[startingat+1] lsh -18) land '777;
data_rows ← M[startingat+1] land '777777;
del_m ← charwidth - 1;
max_m ← left_kern + charwidth -1;
del_n ← data_rows -1;
max_n ← baselinehi - rows_top;
! tpri(<"c "&cvs(character)&" del_m "&cvos(del_m)&" max_m "& cvos(max_m)&
" del_n "&cvos(del_n)&" max_n "&cvos(max_n)&" data_rows "&cvs(data_rows)>);
stash(char_loc0);
stash(character);
stash(dm);
stash4(w);
stash4(byte_count);
stow(boc1);
stow(character);
stow(del_m);
stow(max_m);
stow(del_n);
stow(max_n);
weat ← startingat + 1;
! tpri(<"weat "&cvs(weat)>);
itwas ← 1;
itis ← M[weat ←weat + 1];
! tpri(<cvs(character)&" "&cos(wide)&" itis at start "&cvos(itis)>);
! tpri(<cvos(M[weat+1])&" "&cvos(M[weat+2])&" "&cvos(M[weat+3])>);
! tpri(<cvos(M[weat+4])&" "&cvos(M[weat+5])&" "&cvos(M[weat+6])>);
! tpri(<cvos(M[weat+7])&" "&cvos(M[weat+8])&" "&cvos(M[weat+9])>);
if wide > 36 then
begin "bigc"
weat ← startingat + 1;
itis ← M[weat ← weat + 1];
if itis < 0 then stow(0);
for therow ← 1 til data_rows do
begin "dorows"
first_change ← true;
p_count ← 0;
itwas ← itis;
for column ← 1 til wide do
begin
if itwas > 0 then
begin
if itis > 0 then incr(p_count) else change_c;
end
else
begin
if itis < 0 then incr(p_count) else change_c;
end;
itis ← itis lsh 1;
if column mod 36 = 0 ∧ column≠wide then
itis ← M[weat ← weat + 1];
end;
end "dorows";
end "bigc"
else
begin "litc"
therebe ← point(wide,M[startingat+1],35);
itis ← ildb(therebe) lsh (36 - wide);
while itis = 0 do
begin
decr(data_rows);
incr(rows_top);
itis ← ildb(therebe) lsh (36 - wide);
end;
for therow ← 1 til data_rows do
begin "litdorows"
if therow >1 then itis ← ildb(therebe) lsh (36 - wide);
! tpri(<cvs(therow)&","&cvos(itis)>);
blankrows ← 0;
while itis = 0 do
begin
! tpri(<cvs(therow)&","&" "&cvos(itis)>);
incr(blankrows);
incr(therow);
itis ← ildb(therebe) lsh (36 - wide);
end;
if blankrows > 0 then
begin
stow(skip1);
stow(blankrows);
tpri(<pname(character)&" skip1 "&cvs(blankrows)>);
end;
first_change ← true;
p_count ← 0;
itwas ← itis;
for column ← 1 til wide do
begin
if itwas ≥ 0 then
begin
if itis ≥ 0 then incr(p_count) else change_c;
end
else
begin
if itis < 0 then incr(p_count) else change_c;
end;
itwas ← itis;
itis ← itis lsh 1;
end;
end "litdorows";
end "litc";
stow(eoc);
end "f2gf";
! PIXEL TO GF FONT CONVERSION. The M command WRITEGF;
integer proc writegf(integer array M;integer ctmode;string onfile);
begin "wgf"
integer achan,asize,adum,returnme,i,cha;
define pre = 247; ! preamble;
define no_op = 244; ! no operation;
define post = 248; ! postamble;
define post_post = 249; ! postamble;
define I_D = 131; ! GF identification number;
define stow4(gfh) = ⊂
stow((gfh lsh -24) land '377);
stow((gfh lsh -16) land '377);
stow((gfh lsh -8) land '377);
stow(gfh land '377) ⊃;
define stash4(gfh) = ⊂
stash((gfh lsh -24) land '377);
stash((gfh lsh -16) land '377);
stash((gfh lsh -8) land '377);
stash(gfh land '377) ⊃;
if FT[ctmode]<0 then
begin "ITSNOTTHERE"
tpri(<"Font "&cvs(ctmode)&" is not defined">);
return(-1);
end "ITSNOTTHERE";
for i ←0 til '777 do gfdir[i] ← 0; ! A safety precaution;
i ← 0;
word_count ← 0;
byte_count ← 0;
dir_word_count ← 0;
dir_byte_count ← 0;
stow(pre); ! GF PRE command;
stow(I_D); ! GF ID number;
stow(1); ! Only one byte to follow;
stow(0); ! No message at present;
! tpri(<"WE have stowed "&cvs(pre)&" "&cvs(i_d)&" "&cvs(1)&" "&cvs(0)>);
! tpri(<"The start is "&cvs(gfm[0] lsh -28)&" "&cvs((gfm[0] lsh -20) land '377)&" ">);
achan ← GETMEONEOF(onfile,"GF",adum,adum,adum,'10,0,19,0,"DSK");
if achan<0 then return(0);
! tpri(<"We have opened the gf channel">);
for cha ← 0 til '177 do
if M[ctmode+cha] land '777777 then
fnt_2_gf(M,achan,
((M[FT[ctmode]+cha] lsh 18) ash -18)+FT[ctmode],
(M[FT[ctmode]+cha] lsh -18),cha,M[FT[ctmode]+'201],
M[FT[ctmode]+'203]);
while byte_count mod 4 ≠ 3 do stow(no_op); ! To end POST with full word;
i ← byte_count;
stow(post);
stow4(i); ! Points to byte following last EOC, ignoring the NO_OP's;
stow4(0); ! Save for GF's ds;
stow4(0); ! Save for GF's cs;
stow4(0); ! Save for GF's hppp;
stow4(0); ! Save for GF's vppp;
stow4(0); ! Save for GF's min_m;
stow4(0); ! Save for GF's max_m;
stow4(0); ! Save for GF's min_n;
stow4(0); ! Save for GF's max_n;
stash(post_post);
stash4(i); ! Points to POST command;
stash(I_D);
while (dir_byte_count mod 4) ≠ 0 do stash(233);
while (dir_byte_count mod 4) ≠ 0 do stash(233);
tpri(<"The start is "&cvs(gfm[0] lsh -28)&" "&cvs((gfm[0] lsh -20) land '377)&" ">);
arryout(achan,gfm[0],word_count - 1);
arryout(achan,gfdir[0],dir_word_count - 1);
release(achan);
return(returnme);
end "wgf";